perm filename FOO[C,JRA]1 blob sn#014376 filedate 1972-11-29 generic text, type T, neo UTF8
00050	(SETQ IBASE 10.)
00100	(DE PICKIT(L N)
00200	(PROG(M I J L1)
00300	(SETQ J (ADD1(LENGTH L)))
00500	L1(SETQ I 1)
00600	(SETQ L1 L)
00700	L(COND((NULL L1)(RETURN N))
00750	       ((OR(EQ(CAR L1) N)
00775			(EQ(PLUS(CAR L1) I)(PLUS N J))
00800	           (EQ(DIFFERENCE(CAR L1) I)(DIFFERENCE N J)))(GO AGAIN)))
00900	(SETQ L1(CDR L1))
01000	(SETQ I(ADD1 I))
01050	(GO L)
01100	AGAIN(SETQ N(ADD1 N))
01200	(COND((GREATERP N 8)(RETURN NIL)))
01300	(GO L1)
01400	))
01500	(DE QUEEN()
01600	(PROG(ANS N M CONTEXT)
01650	(SETQ N 1)
01700	L (COND((EQ(LENGTH ANS) 8)(RETURN ANS)))
01750	LL(PRINT(LIST ANS N))
01800	(SETQ M(PICKIT ANS N))
01900	(COND(M
02000	(SETQ CONTEXT(CONS(CONS  M ANS)CONTEXT))
02050	     (SETQ ANS(APPEND ANS(LIST M)))
02100	        (SETQ N 1)(GO L)))
02200	LLL(SETQ N(CAAR CONTEXT))(SETQ ANS(CDAR CONTEXT))(SETQ CONTEXT(CDR CONTEXT))
02325	(SETQ N(ADD1 N))
02350	(COND((GREATERP N 8)(GO LLL)))(GO LL)
02400	))
02500	(QUEEN)